home *** CD-ROM | disk | FTP | other *** search
/ Apple Developer Connection Student Program / ADC Tools Sampler CD Disk 3 1999.iso / Cool Demos, SDKs, & Tools / Demos⁄Tools⁄Offers / Alpha ƒ / Tcl / Packages / compare.tcl next >
Text File  |  1999-02-24  |  4KB  |  143 lines
  1. #========================(install)==========================================
  2. # Compare Windows.
  3. # 
  4. # Simplified (and improved) version of David C. Black's 'compare-windows'.
  5. # Modified by Mark Nagata, 2/23/93, corrected, 2/24/93.
  6. # Sped-up version, 2/25/93.
  7. #
  8. # The return position bug in David's routine (when $patt != "") 
  9. # is fixed in this version.
  10. # 
  11. # Vince renamed a couple of things and added the 'package' stuff so
  12. # this works smoothly with the new Alpha Tcl scheme.  The bindings
  13. # can now be adjusted via a preferences dialog.  Also rewrote a few
  14. # bits to try to avoid window-toggling.
  15. #===========================================================================
  16.  
  17. alpha::extension compareWindows 0.23 {
  18.     namespace eval compare {}
  19.     menu::insert Utils submenu 0 compare
  20.     menu::insert "compare" items end windowsInPlace
  21.     hook::register requireOpenWindowsHook [list compare windowsInPlace] 2
  22.     newPref binding findDifference "/`«X»" compareWindows "" compare::windowsInPlace
  23.     newPref binding findDifferenceIgnoringSpace "/1«X»" compareWindows "" compareOpt
  24.     newPref binding findNextDifference "<U/`«X»" compareWindows "" compareNext
  25.     newPref binding findNextDifferenceIgnoringSpace "<U/1«X»" compareWindows "" compareOptNext
  26.     package::addPrefsDialog compareWindows
  27. }
  28. ####
  29. # On my Extended Keyboard (where the backquote key is to the left of the 
  30. # "1" key), I Bind prefix-(shift)-backquote to 'compare(Next)' and
  31. # prefix-(shift)-1 to 'compareOpt(Next)', as in the above.
  32. # 
  33. # On my Powerbook keyboard (where nothing is to the left of the "1" key),
  34. # I Bind prefix-(shift)-1 to 'compare(Next)' and
  35. # prefix-(shift)-2 to 'compareOpt(Next)', respectively.
  36. ####
  37.  
  38. proc compareOpt {} {
  39.     compare::windowsInPlace -w
  40. }
  41.  
  42. proc compare::windowsInPlace {args} {
  43.     if {[lindex $args 0] == "-w"} {
  44.     set patt "\[ \t\n\r\]+"
  45.     } else {
  46.     set patt {}
  47.     }
  48.     
  49.     set files [winNames -f]
  50.     if {[llength $files] < 2} {
  51.     alertnote "If you want to Compare texts, you need two windows."
  52.     return
  53.     }
  54.     
  55.     watchCursor
  56.     for {set i 1} {$i < 3} {incr i} {
  57.     set wn($i) [lindex $files [expr {$i -1}]]
  58.     set wp($i) [getPos -w $wn($i)]
  59.     select -w $wn($i) $wp($i) $wp($i)
  60.     set wrt($i) [getText -w $wn($i) $wp($i) [maxPos -w $wn($i)]]
  61.     set wt($i) $wrt($i)
  62.     if {$patt != ""} {
  63.         regsub -all $patt $wt($i) " " wt($i)
  64.     }
  65.     }
  66.     
  67.     # Exactly equal
  68.     if {$wt(1) == $wt(2)} {
  69.     alertnote "The windows match from cursors to ends."
  70.     return
  71.     }
  72.     
  73.     # Only consider smaller of two strings
  74.     set siz [string length $wt(1)]
  75.     if {$siz > [string length $wt(2)]} {
  76.     set siz [string length $wt(2)]
  77.     }
  78.     
  79.     # Equal except for added stuff
  80.     set l [expr {$siz-1}]
  81.     if {[string range $wt(1) 0 $l] == [string range $wt(2) 0 $l]} {
  82.     set beg $siz
  83.     set offset(1) $beg
  84.     set offset(2) $beg
  85.     } else {
  86.     set beg 0
  87.     
  88.     while {$siz} {
  89.         set siz [expr {$siz/ 2}]
  90.         set end [expr {$beg+$siz}]
  91.         if {[string range $wt(1) $beg $end] == [string range $wt(2) $beg $end]} {
  92.         incr beg $siz
  93.         incr beg
  94.         }
  95.     }
  96.     set offset(1) $beg
  97.     set offset(2) $beg
  98.     }
  99.     for {set i 2} {$i > 0} {incr i -1} {
  100.     set count $offset($i)
  101.     set pos [pos::math $wp($i) + $count]
  102.     if {$patt != ""} {
  103.         set ans [string range $wt($i) 0 [expr {$offset($i)-1}]]
  104.         set lans [string length $ans]
  105.         set tt [string range $wrt($i) 0 [expr {$count-1}]]
  106.         regsub -all $patt $tt " " tt
  107.         set ltt [string length $tt]
  108.         while {$ltt < $lans} {
  109.         incr count [expr {$lans-$ltt}]
  110.         set pos [pos::math $pos + [expr {$lans-$ltt}]]
  111.         message $pos
  112.         set tt [string range $wrt($i) 0 [expr {$count-1}]]
  113.         regsub -all $patt $tt " " tt
  114.         set ltt [string length $tt]
  115.         }
  116.     }
  117.     
  118.     set pos [expr [pos::compare $pos > [maxPos -w $wn($i)]] ? [maxPos -w $wn($i)] : $pos]
  119.     display -w $wn($i) [pos::math $pos - 1]
  120.     select -w $wn($i) $pos [pos::math $pos + 1]
  121.     refresh $wn($i)
  122.     }
  123.     message "difference found"
  124.     return
  125. }
  126.  
  127. proc compareNext {} {
  128.     endOfLine
  129.     catch {bringToFront [lindex [winNames -f] 1]}
  130.     endOfLine
  131.     compare::windowsInPlace
  132. }
  133.  
  134. proc compareOptNext {} {
  135.     endOfLine
  136.     catch {bringToFront [lindex [winNames -f] 1]}
  137.     endOfLine
  138.     compare::windowsInPlace -w
  139. }
  140.  
  141.  
  142.  
  143.